home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Best of www.BestZips.com (Collector's Edition)
/
Best of WWW.BESTZIPS.COM Collector's Edition (JCSM Shareware) (JCS Marketing).ISO
/
prgtools
/
tn2.zip
/
BINARY.T
< prev
next >
Wrap
Text File
|
1996-11-15
|
3KB
|
189 lines
%
% "binary.t" sorts words using a binary tree
%
% Sample program for the T Interpreter by:
%
% Stephen R. Schmitt
% 962 Depot Road
% Boxborough, MA 01719
%
type word : record
left : int
right : int
item : string
end record
var next_word : string
const root : int := 0
var next : int := root
const size : int := 10
var list : array[size] of word
program
var i : int
% initialize the list
for i := root...size-1 do
list[i].right := 0
list[i].left := 0
list[i].item := ""
end for
% get words
for i := root...size-2 do
prompt "word " & intstr( i + 1, 2 ) & " : "
get next_word
exit when next_word = ""
if lookup( next_word ) then
put "duplicate"
else
insert( next_word )
end if
end for
put ""
traverse( 1 )
end program
function new_item : int
next := next + 1
assert next < size
return next
end function
function lookup( word : string ) : boolean
var i : int := root
var found, done : boolean
done := false
loop
if word = list[i].item then
found := true
done := true
end if
exit when done
if word > list[i].item then
if list[i].right = 0 then
found := false
done := true
else
i := list[i].right
end if
else
if list[i].left = 0 then
found := false
done := true
else
i := list[i].left
end if
end if
exit when done
end loop
return found
end function
procedure insert( word : string )
var i, j : int
var done : boolean
i := root
done := false
loop
if word > list[i].item then
if list[i].right = 0 then
j := new_item
list[i].right := j
list[j].item := word
done := true
else
i := list[i].right
end if
else
if list[i].left = 0 then
j := new_item
list[i].left := j
list[j].item := word
done := true
else
i := list[i].left
end if
end if
exit when done
end loop
end procedure
procedure traverse( node : int )
if node ~= 0 then
traverse( list[node].left )
put list[node].item
traverse( list[node].right )
end if
end procedure